00010	ENTRY PREPARE;
00020	BEGIN
00030	DEFINE ⊂="COMMENT",CR="'15",LF="'12",CRLF="CR&LF",TB="'11";
00040	DEFINE ⊃=" ";	⊂ Used to delete output statements for PLOT;
00050	EXTERNAL REAL ARRAY A,C,D[0:512];
00060	⊃ INTERNAL INTEGER ARRAY NEW[0:512];
00070	INTERNAL INTEGER ARRAY INNAME,INDATA[0:32];
00080	EXTERNAL INTEGER ARRAY FVAL[0:8];
00090	INTEGER I,J,K,P,POINTP,NX;
00100	⊃ EXTERNAL INTEGER CHAN5;
00110	INTERNAL INTEGER INFLAG;
00120	INTEGER F1_LOW,F1_HI,F2_LOW,F2_HI,F3_LOW,F3_HI,F4_LOW,F4_HI,F5_LOW;
00130	INTEGER F5_HI,NP_LOW,NP_HI,NZ_LOW,NZ_HI,FP1_LO,FP1_H,FP2_LO,FP2_H;
00140	INTERNAL INTEGER F1,F2,F3,F4,F5,NP,NZ,FP1,FP2,A1,A2,A3,A4,A5;
00150	INTEGER FA,FB,FC,FD,FE;
00160	INTEGER M1,M2,M3,M4,M5;
00170	
00180	
00190	
00200	
00210	INTERNAL PROCEDURE DEFINES;
00220	BEGIN
00230		F1_LOW←  180 * 256%10000;  F1_HI←  850 * 256%10000;
00240		F2_LOW←  700 * 256%10000;  F2_HI← 2500 * 256%10000;
00250		F3_LOW← 1640 * 256%10000;  F3_HI← 3500 * 256%10000;
00260		F4_LOW← 2500 * 256%10000;  F4_HI← 4500 * 256%10000;
00270		F5_LOW← 3600 * 256%10000;  F5_HI← 5400 * 256%10000;
00280	
00290		M1←	320	* 256%10000;
00300		M2←	1350	* 256%10000;
00310		M3←	2800	* 256%10000;
00320		M4←	3400	* 256%10000;
00330		M5←	4500	* 256%10000;
00340	
00350		FP1_LO← 1800 * 256%10000;  FP1_H← 3200 * 256%10000;
00360		FP2_LO← 3200 * 256%10000;  FP2_H← 5000 * 256%10000;
00370	
00380	
00390		NP_LOW←  800 * 256%10000;  NP_HI← 1500 * 256%10000;
00400		NZ_LOW←NP-500* 256%10000;  NZ_HI←NP+500* 256%10000;
00410	END;
00420	
00430	INTERNAL PROCEDURE DATOUT;
00440	BEGIN
00450	
00460	⊃ ARRYOUT(CHAN5,NEW[0],512);
00470	⊃ POINTP←POINT(9,NEW[1],-1);
00480	NX←0;
00490	 END;
00500	
00510	
00520	
     

00010	INTEGER PROCEDURE PEAK (INTEGER LOW,HIGH);
00020	BEGIN
00030	  INTEGER I,J,K;  REAL MAX,MIN;
00040	
00050	  MAX←-10000; K←LOW;
00060	
00070	  FOR I←LOW STEP 1 UNTIL HIGH DO
00080	    IF C[I]>MAX THEN BEGIN  MAX←C[I]; J←I; END;
00090	
00100	  IF J=LOW THEN BEGIN
00110	    MAX←-10000; MIN←10000;
00120	    FOR I←LOW STEP 1 UNTIL HIGH DO BEGIN
00130	      IF C[I]>MIN THEN DONE;
00140	      IF C[I]<MIN THEN BEGIN MIN←C[I]; K←I; END;
00150	      END;
00160	
00170	    FOR I←K STEP 1 UNTIL HIGH DO
00180	      IF C[I]>MAX THEN BEGIN MAX←C[I]; J←I; END;
00190	    END;
00200	
00210	  IF J=HIGH THEN BEGIN
00220	    MAX←-10000; MIN←10000;
00230	    FOR I←HIGH STEP -1 UNTIL K DO BEGIN
00240	      IF C[I]>MIN THEN DONE;
00250	      IF C[I]<MIN THEN MIN←C[I];
00260	      END;
00270	
00280	    FOR I←I STEP -1 UNTIL K DO
00290	      IF C[I]>MAX THEN  BEGIN  MAX←C[I]; J←I; END;
00300	    END;
00310	
00320	IF J=LOW THEN J←0;    ⊂ No proper peak found;
00330	
00340	  RETURN(J);
00350	END;
00360	
00370	INTEGER PROCEDURE BAND(INTEGER F);
00380	BEGIN
00390	  INTEGER I,J;
00400	
00410	  FOR I←F STEP 1 UNTIL  255 DO IF (C[I]+6)≤C[F] THEN DONE;
00420	⊂  OUTSTR("F="&CVS(F)&TB&"I="&CVS(I)&TB);
00430	  FOR J←F STEP -1 UNTIL 0 DO IF (C[J]+6)≤C[F] THEN DONE;
00440	⊂ OUTSTR("J="&CVS(J)&CRLF);
00450	  IF (F-J)<(I-F) THEN RETURN(F-J) ELSE RETURN(I-F);
00460	END;
00470	
00480	INTEGER PROCEDURE REMOVE(INTEGER F,LIMIT);
00490	BEGIN
00500	INTEGER I,J,K;
00510	REAL X,Y,MAX,MIN;
00520	
00530	FOR I←F STEP 1 UNTIL LIMIT DO IF C[I]≤C[F]-6 THEN BEGIN J←I; DONE; END;
00540	FOR I←F STEP -1 UNTIL 0 DO IF C[I]≤C[F]-6 THEN BEGIN K←I; DONE; END;
00550	IF ABS(F-K)<ABS(J-F) THEN I←ABS(F-K) ELSE I←ABS(J-F);
00560	X←6.0; X←X/(I*I);
00570	MAX←-10000;
00580	⊂ OUTSTR("I="&CVS(I)&"  ");
00590	
00600	FOR I←I+F STEP 1 UNTIL LIMIT DO 
00610	  IF (Y←(C[I]-C[F]+X*(I-F)*(I-F)))>MAX THEN BEGIN MAX←Y; J←I; END;
00620	IF J=LIMIT THEN J←0;
00630	
00640	RETURN(J);
00650	END;
00660	
     

00010	PROCEDURE FORMANT;
00020	BEGIN
00030	
00040	REAL X,Y;
00050	
00060	IF INFLAG=0 THEN BEGIN
00070	⊃     POINTP←POINT(9,NEW[1],-1); NX←0;
00080	
00090		INNAME[P]←CVASC("F1");	P←P+1;
00100		INNAME[P]←CVASC("F2");	P←P+1;
00110		INNAME[P]←CVASC("F3");	P←P+1;
00120		INNAME[P]←CVASC("F4");	P←P+1;
00130		INNAME[P]←CVASC("F5");	P←P+1;
00140	
00150		INNAME[P]←CVASC("A1");	P←P+1;
00160		INNAME[P]←CVASC("A2");	P←P+1;
00170		INNAME[P]←CVASC("A3");	P←P+1;
00180		INNAME[P]←CVASC("A4");	P←P+1;
00190		INNAME[P]←CVASC("A5");	P←P+1;
00200	
00210		INNAME[P]←CVASC("B1");	P←P+1;
00220		INNAME[P]←CVASC("B2");	P←P+1;
00230		INNAME[P]←CVASC("B3");	P←P+1;
00240		INNAME[P]←CVASC("B4");	P←P+1;
00250		INNAME[P]←CVASC("B5");	P←P+1;
00260	
00270	  END ELSE BEGIN
00280	
00290	F1←PEAK(F1_LOW,F1_HI);
00300	
00310	IF (F1+3>INDATA[P])∧(F1+4<F2_LOW) THEN F2←PEAK(F2_LOW,F2_HI)
00315	  ELSE BEGIN
00317	    IF INDATA[P]>F2_LOW THEN F2←PEAK(INDATA[P]+1,F2_HI)
00318	      ELSE F2←PEAK(F2_LOW,F2_HI); END;
00330	
00340	F4←PEAK(F4_LOW,F4_HI);
00350	F5←PEAK(F5_LOW,F5_HI);
00360	
00370	IF F1=F2 THEN BEGIN
00380	⊂  OUTSTR("F1=F2="&CVS(F1*10000%256));
00390	  FA←PEAK(F1_LOW,F1);
00400	  IF FA=0 THEN X←0 ELSE X←C[FA];
00410	  FB←PEAK(F2,F2_HI);
00420	  IF FB=0 THEN Y←0 ELSE Y←C[FB];
00430	  IF (X>Y)∧((X+6)>C[F1]) THEN F1←FA ELSE F2←FB;
00440	  END;
00450	
00460	IF F2=0 THEN F2←REMOVE(F1,F2_HI);
00470	IF F2<F2_LOW THEN F2←INDATA[P+1];
00480	
00490	IF (F2+4) < F3_LOW THEN F3←PEAK(F3_LOW-2,F2_HI)
00500	  ELSE F3←PEAK(F3_LOW,F3_HI);
00510	
00520	IF F2=F3 THEN BEGIN
00530	⊂  OUTSTR("F2=F3="&CVS(F3*10000%256));
00540	  FC←PEAK(F3,F3_HI);
00550	  IF FC=0 THEN Y←0 ELSE Y←C[FC];
00560	  IF F1>F2_LOW THEN FB←PEAK(F1,F3) ELSE FB←PEAK(F2_LOW,F3);
00570	  IF FB=0 THEN X←0 ELSE X←C[FB];
00580	  IF (Y+12>X)∧((Y+24)>C[F3]) THEN F3←FC ELSE F2←FB;
00590	  END;
00600	
00610	IF ((C[F2]+24)<C[F1])∧(F1>F2_LOW) THEN BEGIN
00620	  IF F3>F2_HI THEN FB←REMOVE(F1,F2) ELSE FB←REMOVE(F1,F2_HI);
00630	  IF FB←0 THEN X←0 ELSE X←C[FB];
00640	  IF X>C[F2] THEN F2←FB;
00650	  END;
00660	
00670	IF F3=F4 THEN BEGIN
00680	⊂  OUTSTR("F3=F4="&CVS(F4*10000%256));
00690	  FD←PEAK(F4,F4_HI);
00700	  IF FD=0 THEN Y←0 ELSE Y←C[FD];
00710	  IF F2>F3_LOW THEN FC←PEAK(F2,F4) ELSE FC←PEAK(F3_LOW,F4);
00720	  IF FC=0 THEN X←0 ELSE X←C[FC];
00730	  IF Y+12≥X THEN F4←FD ELSE F3←FC;
00740	  END;
00750	
00760	IF F4=F5 THEN BEGIN
00770	⊂ OUTSTR("F4=F5="&CVS(F5*10000%256));
00780	  FE←PEAK(F5,F5_HI);
00790	  IF FE=0 THEN Y←0 ELSE Y←C[FE];
00800	  IF F3>F4_LOW THEN FD←PEAK(F3,F5) ELSE FD←PEAK(F4_LOW,F5);
00810	  IF FD=0 THEN X←0 ELSE X←C[FD];
00820	⊂ OUTSTR("FD="&CVS(FD*10000%256)&"FE="&CVS(FE*10000%256)&
00830	  "X="&CVS(X)&"Y="&CVS(Y));
00840	  IF Y+12≥X THEN F5←FE ELSE F4←FD;
00850	  END;
00860	
00870	
00880		INDATA[P]←F1;		P←P+1;
00890		INDATA[P]←F2;		P←P+1;
00900		INDATA[P]←F3;		P←P+1;
00910		INDATA[P]←F4;		P←P+1;
00920		INDATA[P]←F5;		P←P+1;
00930		INDATA[P]←C[F1];	P←P+1;
00940		INDATA[P]←C[F2];	P←P+1;
00950		INDATA[P]←C[F3];	P←P+1;
00960		INDATA[P]←C[F4];	P←P+1;
00970		INDATA[P]←C[F5];	P←P+1;
00980	
00990		INDATA[P]←BAND(F1)*10000%256;	P←P+1;
01000		INDATA[P]←BAND(F2)*10000%256;	P←P+1;
01010		INDATA[P]←BAND(F3)*10000%256;	P←P+1;
01020		INDATA[P]←BAND(F4)*10000%256;	P←P+1;
01030		INDATA[P]←BAND(F5)*10000%256;	P←P+1;
01040	  END;
01050	END;
01060	
     

00010	INTERNAL PROCEDURE PREPARE;
00020	BEGIN
00030	
00040	  P←0;
00050	
00060	  FORMANT;
00070	
00080	
00090	⊃ IF INFLAG≠0 THEN BEGIN
00100	⊃   NEW[NX]←FVAL[4];
00110	⊃     FOR I←0 STEP 1 UNTIL 27 DO  IDPB(INDATA[I],POINTP);
00120	⊃     FOR I←1 STEP 1 UNTIL 4 DO IBP(POINTP);
00130	⊃   NX←NX+8;
00140	⊃   IF NX≥512 THEN DATOUT; 
00150	⊃   END;
00160	
00170	END;
00180	
00190	END;
00200